perm filename STUF.FAI[NEW,LCS] blob sn#561088 filedate 1981-02-05 generic text, type T, neo UTF8
	TITLE STUFIT
	ENTRY STUFIT, UNSTUF
; THIS PACKS NUMBERS IN BITS AS FOLLOWS:
;   4  /  5  /  3  /  24
; WDCNT/ P1  / P2   / P3
;  THEN UNSTUF UNPACKS THEM. (P3 MUST BE IN RANGE, +-9999)
STUFIT:	0		;CALL STUFIT(VARRAY,N,I)
			;N=INPUT PNTR, I=OUTPUT PNTR
	SETZM I#	;CALL STUFIT(V,JT)
	MOVEI 1
	MOVEM N#
S1:	MOVEI 1,@(16)	;GET LOC. OF V ARRAY
	ADD 1,N		;ADD TO IT N
	KIFIX 11,-1(1)	;L=V(N)
	MOVE 6,11	;SAVE L IN AC6
	ADDI 11,3	;NX=L+3+N
	ADD 11,N		;NX IS AC11
	KIFIX 15,(1)	;J=V(N+1)
	MOVE 10,11	;LX=NX
S9:	CAIGE 6,2	;IF(L.LT.2)GO TO 12
	JRST S12
	MOVEI 5,@(16)	;IF(V(LX-1).NE.0)GO TO 12
	ADD 5,10		;DROP TRAILING ZERO PARAMS
	SKIPE -2(5)	; -AFTER P3-
	JRST S12
	MOVE [-1.0]	;NOW SET THE WD CNT BACK ONE.
	FADRM -1(1)	;V(N)=V(N)-1.
	SOJ 10,		;LX=LX-1
	SOJA 6,S9	;L=L-1, GO TO 9
S12:	MOVE 6,2(1)	;GET P3
	FMPR 6,[1000.00]	;*1000.00
	KIFIX 6,6	;MAKE IT INTEGER
	JUMPGE 6,S7	;IS IT NEGATIVE? - NO, JUMP TO S7
	MOVNS 6		;NOW IT'S POS.
	ADD 6,[=10000000]  ;+10000000 MEANS IT IS NEG.
S7:	LSHC 6,-=24	;SHIFT IT INTO AC7
	KIFIX 6,1(1)	;GET P2 - STAFF
	LSHC 6,-3
	KIFIX 6,(1)	;GET P1 - CODE
	LSHC 6,-5
	KIFIX 6,-1(1)	;GET WD CNT
	LSHC 6,-4	;NOW ALL IS STUFFED INTO AC7
	MOVEI 1,@(16)	; LOC OF V
	ADD 1,I		; PLUS I
	MOVEM 7,(1)	; PUT PACKED INFO BACK INTO V ARRAY
	MOVEI 1,4
	ADDM 1,N	;ADD 4 TO N
	AOS    I	;ADD 1 TO I
	JRST S16  ;*********  TEMP. SKIP (AVOID RNDOFF ERRS)
	CAIE 15,=16	;IF(J.EQ.16.OR.J.EQ.8)GOTO16
	CAIN 15,8
	JRST S16
	CAIN 15,=11	;IF(J.EQ.11)GO TO 16
	JRST S16
	MOVEI 14,3	;M=3
S3:	CAMN 11,N	;IF(N.EQ.NX)GO TO 2
	JRST S2
	AOJ 14,		;M=M+1
	MOVEI 1,@(16)	;IF(V(N).NE.0)GO TO 4
	ADD 1,N
	SKIPE 2,-1(1)
	JRST S4
S6:	AOS N		;N=N+1
	JRST S3		;GO TO 3
S4:	AOS I		;I=I+1
	MOVE [10000.0]	;X=10000.0
	SKIPGE 2	;IF(V(N).LT.0)X=-X
	MOVNS
	FLTR 4,14	;V(I)=V(N)+M*X
	FMPR 4,0
	FADR 2,4
	MOVEI 1,@(16)
	ADD 1,I
	MOVEM 2,-1(1)
	JRST S6		;GO TO 6
S16:	CAMN 10,N	;IF(N.EQ.LX)GO TO 2
;;S16:	CAMN 11,N	;IF(N.EQ.NX)GO TO 2
;;	JRST S2
	JRST S13
	MOVE 5,N	;DO 5 K=N,NX-1
S5:	AOS I		;I=I+1
	MOVEI 1,@(16)
	ADD 1,N		;5 V(I)=V(K)
	MOVE 6,-1(1)
	MOVEI 1,@(16)
	ADD 1,I
	MOVEM 6,-1(1)
	AOS N
;;	CAME 11,N
	CAME 10,N
	JRST S5
S13:	MOVEM 11,N
S2:	MOVE 6,N
	CAMGE 6,@1(16)	;2  IF(N.LT.JT)GO TO 1
	JRST S1
	MOVE I		;JT=I
	MOVEM @1(16)
	JRA 16,2(16)
UNSTUF:	0	;CALL UNSTUF(Q,V,JT)
	SETZM I		;I=0
	MOVEI 1		;N=1
	MOVEM N
S20:	MOVEI 1,@(16)	;GET LOC OF INPUT ARRAY
	ADD 1,I 	;ADD PNTR I
	MOVEI 3,@1(16)	;GET LOC OF V
	ADD 3,N	;ADD PNTR N
	MOVE 1,(1)	;GET PACKED WORD
	LSHC 1,-=24	;GET P3, SHIFT IT TO AC2
	LSH 2,-=12	;SHIFT IT SOME MORE
	CAMG 2,[=10000000]	;IF .GT.10000000 IT WAS NEG.
	JRST S70
	SUB 2,[=10000000]
	MOVNS 2			;NOW IT'S NEG. AGAIN
S70:	FLTR 2,2
	FDVR 2,[1000.00]
	MOVEM 2,2(3)		;PUT INTO R ARRAY
	LSHC 1,-3	;GET P2
	LSH 2,-=33
	FLTR 2,2
	MOVEM 2,1(3)
	LSHC 1,-5
	LSH 2,-=31	;GET P1
	FLTR 2,2
	MOVEM 2,(3)
	LSHC 1,-4	;GET WD CNT
	LSH 2,-=32
	FLTR 2,2
	MOVEM 2,-1(3)	;ALL DONE
	MOVEI 1,4
	ADDM 1,N	;ADD 4 TO N
	AOS   I 	;ADD 1 TO I
S200:	MOVEI 1,@1(16)	;J=V(N-3)
	ADD 1,N
	SUBI 1,4
	KIFIX 15,(1)	;C GET THE CODE NUM.
	KIFIX 11,-1(1)	;NX=V(N-4)-1+N
	ADD 11,N	;C HOW FAR DO WE GO FOR THIS ITEM?
	SOJ 11,
	JRST S36	;****** TEMPORARY
	CAIE 15,=16	;IF(J.EQ.16)GO TO 36
	CAIN 15,=8	;IF(J.EQ.8)GO TO 36
	JRST S36
	CAIN 15,=11	;IF(J.EQ.11)GO TO 36
	JRST S36
	MOVEI 14,3	;M=3
S22:	CAMN 11,N	;22	IF(N.EQ.NX)GO TO 32
	JRST S32
	AOJ 14,		;M=M+1
	AOS I		;I=I+1
	MOVEI 1,@(16)	;L=Q(I)/10000.0
	ADD 1,I
	MOVE 2,-1(1)
	FDVR 2,[10000.0]
	KIFIX 13,2	;AC13 IS L
	MOVM 12,13	;C GET THE PARAM NUM.	LL=IABS(L)
S24:	CAMN 12,14	;24	IF(LL.EQ.M)GO TO 21
	JRST S21
	CAME 11,N	;IF(N.NE.NX)GO TO 25
	JRST S25
	SOS I		;I=I-1
	JRST S32	;GO TO 32
S25:	MOVEI 2,@1(16)
	ADD 2,N
	SETZM -1(2)	;25	V(N)=0  PUT BACK IN THE ZERO PARAMS.
	AOJ 14,		;M=M+1
S23:	AOS N		;23	N=N+1
	JRST S24	;GO TO 24
S21:	IMULI 13,=10000	;21	X=Q(I)-L*10000
	MOVE 2,[0.001]		;Z=0.001
	SKIPGE 13		;IF(Q(I).LT.0)Z=-Z
	MOVNS 2
	FLTR 13,13	;C GET BACK THE REAL CONTENTS OF THE PARAM.
	MOVE 1,-1(1)	;Q(I)
	FSBR 1,13	;AC1 IS X
	SKIPE 1		;IF(X.NE.0)X=X+Z  FOR ROUNDOFF ERRORS
	FADR 1,2
	MOVEI 2,@1(16)	;V(N)=X
	ADD 2,N
	MOVEM 1,-1(2)
	AOS N		;N=N+1
	JRST S22	;GO TO 22
S36:	CAMN 11,N	;36	IF(N.EQ.NX)GO TO 32
	JRST S32
	MOVE 5,N	;DO 35 K=N,NX-1
S35:	AOS I	;	I=I+1
	MOVEI 2,@1(16)	;GET LOC OF V ARRAY
	MOVEI 1,@(16)	;LOC OF Q ARRAY  35	V(K)=Q(I)
	ADD 2,N
	ADD 1,I
	MOVE 6,-1(1)	;Q(I)
	MOVEM 6,-1(2)
	AOS N
	CAME 11,N
	JRST S35	;N=NX
S32:	MOVE I
	CAMGE @2(16)	;32	IF(I.LT.JT)GO TO 20
	JRST S20
	MOVE N		;JT=N
	MOVEM @2(16)	;GET NEW WD CNT
	JRA 16,3(16)
	END